DEFINT A-Z

TYPE WAVHeaderType
  RIFFID AS STRING*4
  RIFFLEN AS LONG
  WAVID AS STRING*4
  FMTID AS STRING*4
  FMTLEN AS LONG
  FMTTAG AS INTEGER
  CHANNELS AS INTEGER
  FREQ AS LONG
  BYTESSEC AS LONG
  ALIGN AS INTEGER
  FMTSPEC AS INTEGER
  DATAID AS STRING*4
  DATALEN AS LONG
END TYPE

TYPE SBType
  STAT AS INTEGER
  VER0 AS INTEGER
  VER1 AS INTEGER
  BASEPORT AS INTEGER
  IRQ AS INTEGER
  DMA AS INTEGER
  HDMA AS INTEGER
  PGPORT AS INTEGER
  ADDPORT AS INTEGER
  LENPORT AS INTEGER
  MODEREG AS INTEGER
  S16 AS INTEGER
END TYPE

CONST BUFLEN=8192

TYPE PLAYWAVType
  FILENUM AS INTEGER
  STAT AS INTEGER
  HDR AS WAVHeaderType
  FSIZE AS LONG
  FPOS AS LONG
  BUFUSE AS INTEGER
  BUF0DLEN AS INTEGER
  BUF0 AS STRING*BUFLEN
  BUF1DLEN AS INTEGER
  BUF1 AS STRING*BUFLEN
END TYPE

CONST WAVHeaderSize=45
COMMON SHARED SB AS SBType,PWAV AS PLAYWAVType

CALL InitSoundCard(SB)
IF SB.STAT<>1 THEN COLOR 12,0:PRINT "Sound Blaster 16 not found":BEEP:END
CALL MainLoop
CALL ResetDSP(SB)
CLOSE:COLOR 7,0:PRINT""
END

SUB MainLoop()
  STATIC PAUSE AS INTEGER
  PAUSE=0
  INPUT "WAV File:",F$
  IF F$="" THEN COLOR 12,0:PRINT "Filename not specified":BEEP:EXIT SUB
  CALL LoadWAV(PWAV,SB,F$)
  IF PWAV.FILENUM<=0 OR PWAV.STAT<0 THEN
    COLOR 12,0:PRINT "Failed to load wav file":BEEP:EXIT SUB
  END IF
  WHILE PWAV.STAT<>2
    CALL DisplayInfo(PWAV,PAUSE)
    IF PAUSE=0 THEN
      CALL PlayWAVTask(PWAV,SB)
    END IF
    SELECT CASE UCASE$(INKEY$)
      CASE CHR$(27)
	PWAV.STAT=2
      CASE "Q":
	PWAV.STAT=2
      CASE " ":
	PAUSE=NOT PAUSE
    END SELECT
  WEND
END SUB

SUB DisplayInfo(PWAV AS PLAYWAVType,PAUSE AS INTEGER)
  STATIC BPS AS LONG,S0 AS LONG,S1 AS LONG
  LOCATE ,1,0
  COLOR 13,0:PRINT CHR$(14)+" ";
  IF PAUSE=0 THEN COLOR 14,1:PRINT "  PLAY  "; ELSE COLOR 15,1:PRINT " PAUSED ";
  BPS=PWAV.HDR.FREQ*PWAV.HDR.CHANNELS:IF PWAV.HDR.FMTSPEC=16 THEN BPS=BPS*2
  S0=(PWAV.FPOS-WAVHeaderSize)/BPS
  S1=(PWAV.FSIZE-WAVHeaderSize)/BPS
  COLOR 14,0:PRINT " [";GetTime$(S0);" / ";GetTime$(S1);"]";
  COLOR 7,0
END SUB

FUNCTION GetTime$(S AS LONG)
  STATIC SEC AS INTEGER,MIN AS INTEGER,SSEC$,SMIN$
  SEC=S MOD 60:MIN=(S\60)
  SSEC$=LTRIM$(RTRIM$(STR$(SEC))):IF SEC<10 THEN SSEC$="0"+SSEC$
  SMIN$=LTRIM$(RTRIM$(STR$(MIN))):IF MIN<10 THEN SMIN$="0"+SMIN$
  GetTime$=SMIN$+":"+SSEC$
END FUNCTION

SUB LoadWAV(PWAV AS PLAYWAVType,SB AS SBType,WAVFILE AS STRING)
  STATIC S16
  IF PWAV.FILENUM>0 THEN CLOSE PWAV.FILENUM:PWAV.FILENUM=-1
  PWAV.FSIZE=0
  PWAV.STAT=0
  PWAV.FILENUM=FREEFILE
  OPEN WAVFILE FOR BINARY AS PWAV.FILENUM
  IF LOF(PWAV.FILENUM)=0 THEN
    CLOSE PWAV.FILENUM:KILL WAVFILE:PWAV.FILENUM=-1:EXIT SUB
  END IF
  GET PWAV.FILENUM,1,PWAV.HDR
  IF UCASE$(PWAV.HDR.RIFFID)<>"RIFF" THEN PWAV.STAT=-1:EXIT SUB
  IF UCASE$(PWAV.HDR.WAVID)<>"WAVE" THEN PWAV.STAT=-2:EXIT SUB
  IF PWAV.HDR.FMTTAG<>1 THEN PWAV.STAT=-3:EXIT SUB 'Not PCM format
  IF PWAV.HDR.FMTSPEC=16 THEN CALL SetMode(SB,1) ELSE CALL SetMode(SB,0)
  PWAV.STAT=0
  PWAV.FSIZE=LOF(PWAV.FILENUM)
END SUB

SUB PlayWAVTask(PWAV AS PLAYWAVType,SB AS SBType)
  STATIC DATALEN AS INTEGER,BUFADDR AS LONG
  IF (PWAV.STAT=1 AND DMADone(SB)=0) OR PWAV.STAT=2 THEN
    EXIT SUB
  ELSEIF PWAV.STAT=0 THEN
    PWAV.STAT=1
    PWAV.BUFUSE=0
    SEEK PWAV.FILENUM,WAVHeaderSize
    PWAV.FPOS=LOC(PWAV.FILENUM)
    GET PWAV.FILENUM,,PWAV.BUF0
    PWAV.BUF0DLEN=LOC(PWAV.FILENUM)-PWAV.FPOS
    PWAV.FPOS=LOC(PWAV.FILENUM)
  END IF
  IF PWAV.BUFUSE=1 THEN
    BUFADDR=INT2ULONG&(VARSEG(PWAV.BUF1))*16+INT2ULONG&(VARPTR(PWAV.BUF1))
    DATALEN=PWAV.BUF1DLEN-1
  ELSE
    BUFADDR=INT2ULONG&(VARSEG(PWAV.BUF0))*16+INT2ULONG&(VARPTR(PWAV.BUF0))
    DATALEN=PWAV.BUF0DLEN-1
  END IF
  IF DATALEN<0 THEN PWAV.STAT=2:EXIT SUB

  IF SB.S16 THEN
    OUT &HD8,0 'clear flip flop
    OUT &HD6,SB.MODEREG
    OUT SB.ADDPORT,(BUFADDR\2) AND 255
    OUT SB.ADDPORT,(BUFADDR\512) AND 255
    OUT SB.PGPORT,(BUFADDR\131072)*2
    OUT SB.LENPORT,(DATALEN\2) AND 255
    OUT SB.LENPORT,(DATALEN\512) AND 255
    OUT &HD4, SB.HDMA-4
  ELSE
    OUT &HA,&H4+SB.DMA
    OUT &HC,&H0
    OUT &HB,SB.MODEREG
    OUT SB.ADDPORT,(BUFADDR) AND 255
    OUT SB.ADDPORT,(BUFADDR\256) AND 255
    OUT SB.PGPORT,BUFADDR\65536
    OUT SB.LENPORT,DATALEN AND 255
    OUT SB.LENPORT,(DATALEN\256) AND 255
    OUT &HA,SB.DMA
  END IF
  CALL WriteDSP(SB,&H41)
  CALL WriteDSP(SB,PWAV.HDR.FREQ\256)
  CALL WriteDSP(SB,PWAV.HDR.FREQ AND 255)
  IF SB.S16 THEN
    CALL WriteDSP(SB,&HB0) '16 bit DAC, single cycle, FIFO off
    IF PWAV.HDR.CHANNELS=2 THEN 'subtract 10h for unsigned
      CALL WriteDSP(SB,&H30) '30h=Mode byte for 16 bit signed stereo
    ELSE
      CALL WriteDSP(SB,&H10) '10h=Mode byte for 16 bit signed mono
    END IF
    CALL WriteDSP(SB,(DATALEN\2) AND 255)
    CALL WriteDSP(SB,(DATALEN\512) AND 255)
  ELSE
    CALL WriteDSP(SB,&HC0) '8 bit DAC, single cycle, FIFO off
    IF PWAV.HDR.CHANNELS=2 THEN
      CALL WriteDSP(SB,&H20) '20h=Mode byte for 8 bit unsigned stereo
    ELSE
      CALL WriteDSP(SB,&H0)  '0h=Mode byte for 8 bit unsigned mono
    END IF
    CALL WriteDSP(SB,(DATALEN) AND 255)
    CALL WriteDSP(SB,(DATALEN\256) AND 255)
  END IF
  PWAV.BUFUSE=(NOT PWAV.BUFUSE) AND 1
  IF PWAV.BUFUSE=1 THEN
    GET PWAV.FILENUM,,PWAV.BUF1
    PWAV.BUF1DLEN=LOC(PWAV.FILENUM)-PWAV.FPOS
  ELSE
    GET PWAV.FILENUM,,PWAV.BUF0
    PWAV.BUF0DLEN=LOC(PWAV.FILENUM)-PWAV.FPOS
  END IF
  PWAV.FPOS=LOC(PWAV.FILENUM)
END SUB

SUB InitSoundCard(SB AS SBType)
  STATIC ENV$
  SB.BASEPORT=220:SB.IRQ=5:SB.DMA=1:SB.HDMA=5
  ENV$=UCASE$(ENVIRON$("BLASTER"))
  FOR I=1 TO LEN(ENV$)
    SELECT CASE MID$(ENV$,I,1)
      CASE "A"
        SB.BASEPORT=VAL("&H"+MID$(ENV$,I+1,3))
      CASE "I"
        SB.IRQ=VAL(MID$(ENV$,I+1,1))
      CASE "D"
        SB.DMA=VAL(MID$(ENV$,I+1,1))
      CASE "H"
        SB.HDMA=VAL(MID$(ENV$,I+1,1))
    END SELECT
  NEXT I
  IF SB.DMA<0 OR SB.DMA>3 OR SB.HDMA<4 OR SB.HDMA>7 THEN
    SB.STAT=0:EXIT SUB 'Invalid Parameter
  END IF
  CALL ResetDSP(SB)
  IF SB.STAT=-1 THEN EXIT SUB 'No sound card
  CALL WriteDSP(SB,&HE1)
  SB.VER0=ReadDSP(SB)
  SB.VER1=ReadDSP(SB)
  IF SB.VER0<4 THEN SB.STAT=-2:EXIT SUB 'Pre-SB16 sound card not supported
END SUB

SUB SetMode(SB AS SBType,S16 AS INTEGER)
  IF S16>0 THEN
    SB.S16=1
    SELECT CASE SB.HDMA
      CASE 4
        SB.PGPORT=&H0:SB.ADDPORT=&HC0:SB.LENPORT=&HC2:SB.MODEREG=&H48
      CASE 5
        SB.PGPORT=&H8B:SB.ADDPORT=&HC4:SB.LENPORT=&HC6:SB.MODEREG=&H49
      CASE 6
        SB.PGPORT=&H89:SB.ADDPORT=&HC8:SB.LENPORT=&HCA:SB.MODEREG=&H4A
      CASE 7
        SB.PGPORT=&H8A:SB.ADDPORT=&HCC:SB.LENPORT=&HCE:SB.MODEREG=&H4B
      CASE ELSE
        EXIT SUB
    END SELECT
  ELSE
    SB.S16=0
    SELECT CASE SB.DMA
      CASE 0
        SB.PGPORT=&H87:SB.ADDPORT=&H0:SB.LENPORT=&H1:SB.MODEREG=&H48
      CASE 1
        SB.PGPORT=&H83:SB.ADDPORT=&H2:SB.LENPORT=&H3:SB.MODEREG=&H49
      CASE 2
        SB.PGPORT=&H81:SB.ADDPORT=&H4:SB.LENPORT=&H5:SB.MODEREG=&H4A
      CASE 3
        SB.PGPORT=&H82:SB.ADDPORT=&H6:SB.LENPORT=&H7:SB.MODEREG=&H4B
      CASE ELSE
        EXIT SUB
    END SELECT
  END IF
END SUB

SUB ResetDSP(SB AS SBType)
  SB.STAT=0
  OUT SB.BASEPORT+&H6,1:CT=0
  DO
    OUT SB.BASEPORT+&H6,0
    STAT=INP(SB.BASEPORT+&HE)
    STAT=INP(SB.BASEPORT+&HA)
    IF STAT=&HAA THEN SB.STAT=1:EXIT DO
    CT=CT+1
  LOOP WHILE CT<100
END SUB

SUB WriteDSP(SB AS SBType,BYTE AS INTEGER)
  WHILE INP(SB.BASEPORT+12) AND &H80:WEND
  OUT SB.BASEPORT+12,BYTE
END SUB

FUNCTION ReadDSP(SB AS SBType)
  STATIC DSPIN AS INTEGER
  WAIT (SB.BASEPORT+&HE),&H80
  DO: DSPIN=INP(SB.BASEPORT+10): LOOP UNTIL DSPIN<>&HAA
  ReadDSP=DSPIN
END FUNCTION

FUNCTION DMADone(SB AS SBType)
  STATIC LO AS INTEGER,HI AS INTEGER,ACK AS INTEGER
  LO=INP(SB.LENPORT):HI=INP(SB.LENPORT)
  IF HI=255 AND LO=255 THEN ACK=INP(SB.BASEPORT+&HF):DMADone=-1 ELSE DMADone=0
END FUNCTION

FUNCTION INT2ULONG&(V AS INTEGER)
  IF V<0 THEN INT2ULONG&=CLNG(V+65536) ELSE INT2ULONG&=CLNG(V)
END FUNCTION

